home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Tele / Pete Johnson / AreaTrix 1.0.4<source> Folder / New File Utils.p < prev    next >
Encoding:
Text File  |  1990-11-19  |  3.9 KB  |  167 lines  |  [TEXT/PJMM]
  1. unit NewFileUtils;
  2.  
  3. {    Created June 24, 1989, to aid Toolbox file calls.                                        }
  4.  
  5. interface
  6.  
  7.  
  8. uses
  9.     HelloTabby, Globals;
  10.  
  11. function MyWrite (FileRefNum: integer; var TheLine: str255): OSErr;
  12.  
  13. function MyWriteLine (FileRefNum: integer; var TheLine: str255): OSErr;
  14.  
  15. function AtEOF (fRefNum: Integer): Boolean;
  16.  
  17. procedure FrameDItem (dLog: DialogPtr; iNum: integer);
  18.  
  19. procedure MakeTextFile (filename: STR255);
  20.  
  21. function Int2Char (Number: integer): char;
  22.  
  23. function TwoDigit (Number: integer): string;
  24.  
  25. procedure TimeStamp;
  26.  
  27.  
  28. implementation
  29.  
  30. { ------------------------------------------------------ }
  31.  
  32. procedure FrameDItem;
  33.  
  34.     var
  35.         iBox: Rect;
  36.         iType: integer;
  37.         iHandle: Handle;
  38.         oldPenState: PenState;
  39.  
  40.     begin
  41.         GetPenState(oldPenState);
  42.         GetDItem(dLog, iNum, iType, iHandle, iBox);
  43.         InsetRect(iBox, -4, -4);
  44.         PenSize(3, 3);
  45.         FrameRoundRect(iBox, 16, 16);
  46.         SetPenState(oldPenState)
  47.     end;
  48.  
  49. {-----------------------------------------------------------------    }
  50.  
  51. procedure MakeTextFile;
  52.  
  53. { Procedure sets up QUED-compatible text  file                                }
  54.  
  55.     var
  56.         fndrInfo: FInfo;
  57.  
  58.     begin
  59.         Err := GetFInfo(FileName, vRefNum, fndrInfo);
  60.         if Err = noErr then
  61.             begin
  62.                 fndrInfo.fdType := 'TEXT';
  63.                 fndrInfo.fdCreator := 'QED1';
  64.                 Err := SetFInfo(FileName, vRefNum, fndrInfo);
  65.             end
  66.         else
  67.             Err := Create(FileName, vRefNum, 'QED1', 'TEXT');
  68.     end;
  69.  
  70. {-----------------------------------------------------------------    }
  71.  
  72. function Int2Char;
  73.  
  74. { Function changes integer to character.                        }
  75.  
  76.     begin
  77.         Int2Char := chr(Number + ord('0'));
  78.     end;
  79.  
  80. { ------------------------------------------------------ }
  81.  
  82. function TwoDigit;
  83.  
  84. { Function changes two-digit number to a two-character string.        }
  85.  
  86.     begin
  87.         TwoDigit := concat(Int2Char(Number div 10), Int2Char(Number mod 10));
  88.     end;
  89.  
  90. { ------------------------------------------------------ }
  91.  
  92. procedure TimeStamp;
  93.  
  94.     var
  95.         Today: DateTimeRec;
  96.         ThisYear, ThisMonth, ThisDate, ThisHour, ThisMin, ThisSec: integer;
  97.         ASCIIHour: string;
  98.  
  99.     begin
  100.         GetTime(Today);
  101.         with Today do
  102.             begin
  103.                 ThisYear := Year;
  104.                 ThisMonth := Month;
  105.                 ThisDate := Day;
  106.                 ThisHour := Hour;
  107.                 ThisMin := Minute;
  108.                 ThisSec := Second
  109.             end;
  110.  
  111. { The TwoDigit function in the following section turns a two-digit integer      }
  112. { into a two-character string. If there are fewer than two digits, the string    }
  113. { contains a leading '0'.                                                                              }
  114.  
  115.         ASCIIHour := TwoDigit(ThisHour);            {    This bit of nonsense is to get the Tabby Log output        }
  116.         if length(ASCIIHour) > 1 then                {    to match a Tabby convention: single-digit hours do        }
  117.             if (copy(ASCIIHour, 1, 1) = '0') then        {    not have leading zeroes, even though all other single        }
  118.                 ASCIIHour := copy(ASCIIHour, 2, 1);        {    digit numbers do.                                    }
  119.  
  120.         DateString := concat(TwoDigit(ThisMonth), '/', TwoDigit(ThisDate), '/', TwoDigit(ThisYear - 1900));
  121.         TimeString := concat(TwoDigit(ThisHour), ':', TwoDigit(ThisMin), ':', TwoDigit(ThisSec));
  122.         TabbyStamp := concat(DateString, ' ', ASCIIHour, ':', TwoDigit(ThisMin), ':', TwoDigit(ThisSec), ' ');
  123.     end;
  124.  
  125. { ------------------------------------------------------ }
  126.  
  127. function AtEOF;        {     (fRefNum: Integer): Boolean;    }
  128.  
  129.     var
  130.         currPos, eofPos: LongInt;
  131.  
  132.     begin
  133.         Err := GetFPos(fRefNum, currPos);
  134.         Err := GetEOF(fRefNum, eofPos);
  135.         AtEOF := currPos = eofPos
  136.     end;
  137.  
  138. { ------------------------------------------------------ }
  139.  
  140. function MyWrite;        {     (FileRefNum: integer; var TheLine: str255): OSErr;    }
  141.  
  142.     var
  143.         TheLength: longint;
  144.  
  145.     begin
  146.         TheLength := length(TheLine);
  147.         MyWrite := FSWrite(FileRefNum, TheLength, Pointer(ord(@TheLine) + 1))
  148.     end;
  149.  
  150. { ------------------------------------------------------ }
  151.  
  152. function MyWriteLine;        {     (FileRefNum: integer; var TheLine: str255): OSErr;    }
  153.  
  154.     var
  155.         CR: SignedByte;
  156.         TheLength: longint;
  157.  
  158.     begin
  159.         MyWriteLine := MyWrite(FileRefNum, TheLine);
  160.         CR := 13;
  161.         TheLength := 1;
  162.         MyWriteLine := FSWrite(FileRefNum, TheLength, @CR)
  163.     end;
  164.  
  165. { ------------------------------------------------------ }
  166.  
  167. end.    {    Unit    }